home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / MSDOS / (m)aas / WHATIS.ARC / WHAT.PAS < prev   
Pascal/Delphi Source File  |  1985-11-21  |  6KB  |  190 lines
  1. Program What;
  2.  
  3. (* This program manages a file called WHAT.DAT, that contains short
  4.    descriptions of what programs and files are for. It uses the DOS
  5.    command buffer for obtaining program information, then searches
  6.    the what.dat file for all matches.                              *)
  7.  
  8. Var
  9.      Search:string[12];
  10.      Yep,Command:char;
  11.      What_File:Text;
  12.      Search_Data,
  13.      What_Text:String[60];
  14.      Line:string[80];
  15.      Found,stop:Boolean;
  16. Const
  17.      What_File_Name='\what.dat';
  18.      Spaces = '               ';
  19. (********************************************************************)
  20. Procedure Parse;
  21. (* This procedure reads the command line for program information. If the
  22.    command is print or open, the procedure returns immediately. If it is
  23.    anything else, it will look for a filename. The command is returned in
  24.    the char variable COMMAND, and the filename is returned in the string
  25.    SEARCH. *)
  26.  
  27. Var I:Integer;
  28.  
  29. Begin
  30.      Search:='';
  31.      If ParamCount = 0 then begin stop:=True; Exit; End;
  32.      Command:=Upcase(copy(ParamStr(1),1,1));
  33.      If (ParamCount < 2) then
  34.         Begin
  35.             If not(Command in ['P','O']) then
  36.                Stop:=True;
  37.         End
  38.      Else
  39.            For I:= 1 to length(Paramstr(2)) do
  40.                Search:=Concat(Search,Upcase(Copy(Paramstr(2),I,1)));
  41. End;
  42.  
  43. (****************************************************************************)
  44. Procedure Open_File;
  45.  
  46. Begin
  47.        Reset(What_File);
  48. End;
  49. (****************************************************************************)
  50. Procedure Close_File;
  51.  
  52. Begin
  53.      Close(What_File);
  54. End;
  55. (****************************************************************************)
  56. Procedure Find;
  57. (* This routine searches WHAT.DAT for the next occurance of SEARCH
  58.    if it is found, the FOUND flag is set true, otherwise it is set
  59.    false.                                                         *)
  60. Begin (* Find *)
  61.  
  62.           Found := False;
  63.           While (Not Found) and (Not EOF(What_File)) do
  64.                 Begin (* While Structure *)
  65.                      Readln(What_File,Line);
  66.                      If (Copy(Line,1,length(Search))) = Search then
  67.                         Found:= True;
  68.                 End;  (* While structure *)
  69. End; (* Find *)
  70.  
  71. (*************************************************************************)
  72. Procedure Is;
  73.  
  74. Begin
  75.      Open_File;
  76.      Find;
  77.      If Found then
  78.         Begin
  79.             Writeln;
  80.             Writeln(Line);
  81.             While (not EOF(What_File)) do
  82.                   Begin
  83.                        Find;
  84.                        if found then Writeln(Line);
  85.                   End;
  86.         End
  87.         Else
  88.             Writeln(Search, ' was not in WHAT.DAT file.');
  89.      Close_File;
  90. End;
  91.  
  92. (****************************************************************************)
  93. Procedure Enter_New;
  94.  
  95. Begin
  96.      Open_File;
  97.      Find;
  98.      Close_File;
  99.      If found then
  100.               Begin     (* File Found *)
  101.                    Writeln('File already exists:');
  102.                    Writeln(Line);
  103.                    Exit;
  104.               End;      (* File Found *)
  105.  
  106.      Repeat
  107.            Writeln('Describe ',search,' in 60 characters or less');
  108.            Writeln('|--------1---------2---------3---------4---------5---------|');
  109.            Readln(What_Text);
  110.            Writeln;
  111.            Writeln(Search,copy(spaces,1,(13-length(search))),'- ',What_Text);
  112.            Writeln;
  113.            Write('Is this correct (Y/N/Q)? ');
  114.            Repeat
  115.                       Read(kbd,Yep);
  116.                       Yep:=Upcase(Yep);
  117.            Until (Yep in ['Y','N','Q']);Writeln(Yep);
  118.            If Yep = 'Q' then Exit;
  119.      Until Yep = 'Y';
  120.  
  121.      Append(What_File);
  122.      Writeln(What_File,Search,copy(spaces,1,(13-length(search))),'- ',What_Text);
  123.      Close_File;
  124. End;
  125.  
  126. (****************************************************************************)
  127. Procedure Open_New;
  128. Begin
  129.      Writeln('Create new data file. Old data file will be overwritten.');
  130.      Write('ARE YOU SURE? (Y/N) ');
  131.            Repeat
  132.                       Read(kbd,Yep);
  133.                       Yep:=Upcase(Yep);
  134.            Until (Yep in ['Y','N']);Writeln(Yep);
  135.      If Yep <> 'Y' then exit;
  136.      Rewrite(What_File);
  137.      Close_File;
  138.      Writeln('New WHAT.DAT file has been created in the root directory.');
  139. End;
  140.  
  141. (****************************************************************************)
  142. Procedure Print_File;
  143. Begin
  144.      Write('Print WHAT.DAT to the printer. ARE YOU SURE? (Y/N) ');
  145.            Repeat
  146.                       Read(kbd,Yep);
  147.                       Yep:=Upcase(Yep);
  148.            Until (Yep in ['Y','N']);Writeln(Yep);
  149.      If Yep <> 'Y' then exit;
  150.      Open_File;
  151.      Write('Printing File.....',^m);
  152.      Repeat
  153.            Readln(What_File,Line);
  154.            Writeln(Lst,Line);
  155.      Until eof(What_File);
  156.      Writeln('Printing Completed');
  157.      Close_File;
  158. End;
  159.  
  160. (****************************************************************************)
  161. Procedure Explain;
  162.  
  163. Begin
  164.      Writeln (^g,'WHAT   (c) 1985 by Kevin Ross     V1.3  11/21/1985');
  165.      Writeln;
  166.      Writeln ('What Syntax:');
  167.      Writeln ('               WHAT OPEN                 (* opens new WHAT.DAT file *)');
  168.      Writeln ('               WHAT NEW filename.ext     (* adds data to file       *)');
  169.      Writeln ('               WHAT IS  filename.ext     (* Searchs for first match *)');
  170.      Writeln ('               WHAT PRINT                (* Sends all data to printer *)');
  171.      Writeln ;
  172. End;
  173.  
  174. (****************************************************************************)
  175. Begin
  176.      Stop:=false;
  177.      Assign(What_File,What_File_Name);
  178.      Parse;
  179.      If stop or (Not(Command in ['P','O','I','N'])) then
  180.         explain
  181.      Else
  182.         Case Command of
  183.              'P' : Print_File;
  184.              'O' : Open_New;
  185.              'I' : Is;
  186.              'N' : Enter_New;
  187.              End;
  188. End.
  189.  
  190.